home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-13 / folded_u.zip / EXAMPLE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-04  |  16KB  |  423 lines
  1. (*@/// description, copyright, etc... *)
  2. {----------------------------------------------------------------------}
  3. {                          ASYNC4U.PAS                                 }
  4. {                                                                      }
  5. {  This is a faithful translation of the famous ASYNC.INC by Michael   }
  6. {  Quinlan into a Turbo 4.0 unit.  No extra frills, no modification of }
  7. {  types, nothing fancy.  But with this code you should be able to     }
  8. {  delete your $I ASYNC.INC directive, add a USES ASYNC4U statement,   }
  9. {  and recompile your existing program.  If you want to add support    }
  10. {  for more ports, other computers, or change to use the new data      }
  11. {  types, all good ideas, go right ahead. With this you don't have to. }
  12. {                                                                      }
  13. {                                      Scott Gurvey, November 29 1987  }
  14. {----------------------------------------------------------------------}
  15. {                                                                      }
  16. {                          ASYNC.INC                                   }
  17. {                                                                      }
  18. {  Async Communication Routines                                        }
  19. {  by Michael Quinlan                                                  }
  20. {  with a bug fixed by Scott Herr                                      }
  21. {  made PCjr-compatible by W. M. Miller                                }
  22. {  Highly dependant on the IBM PC and PC DOS 2.0                       }
  23. {                                                                      }
  24. {  based on the DUMBTERM program by CJ Dunford in the January 1984     }
  25. {  issue of PC Tech Journal.                                           }
  26. {                                                                      }
  27. {  Entry points:                                                       }
  28. {                                                                      }
  29. {    Async_Init                                                        }
  30. {      Performs initialization.                                        }
  31. {                                                                      }
  32. {    Async_Open(Port, Baud : Integer;                                  }
  33. {               Parity : Char;                                         }
  34. {               WordSize, StpBits : Integer) : Boolean                 }
  35. {      Sets up interrupt vector, initialies the COM port for           }
  36. {      processing, sets pointers to the buffer.  Returns FALSE if COM  }
  37. {      port not installed.                                             }
  38. {                                                                      }
  39. {    Async_Buffer_Check(var C : Char) : Boolean                        }
  40. {      If a character is available, returns TRUE and moves the         }
  41. {        character from the buffer to the parameter                    }
  42. {      Otherwise, returns FALSE                                        }
  43. {                                                                      }
  44. {    Async_Send(C : Char)                                              }
  45. {      Transmits the character.                                        }
  46. {                                                                      }
  47. {    Async_Send_String(S : LStr)                                       }
  48. {      Calls Async_Send to send each character of S.                   }
  49. {                                                                      }
  50. {    Async_Close                                                       }
  51. {      Turn off the COM port interrupts.                               }
  52. {      **MUST** BE CALLED BEFORE EXITING YOUR PROGRAM; otherwise you   }
  53. {      will see some really strange errors and have to re-boot.        }
  54. {                                                                      }
  55. {----------------------------------------------------------------------}
  56. (*@\\\*)
  57. (*@/// compiler switches *)
  58. {$B-} { Short circuit boolean ON }
  59. {$I-} { I/O hecking OFF }
  60. {$R-} { Range checking OFF }
  61. {$S-} { Stack checking OFF }
  62. {$V-} { Var-str checking OFF}
  63. (*@\\\*)
  64.  
  65. unit async4u;
  66. (*@/// interface *)
  67. interface
  68.  
  69. uses dos;
  70.  
  71. (*@/// global declarations *)
  72. type
  73.   LStr = String[255];  { generic string type for parameters }
  74.  
  75. const
  76.   Async_Buffer_Max = 4095;
  77.  
  78. var
  79.   Async_OriginalVector : pointer;
  80.   Async_Buffer       : Array[0..Async_Buffer_Max] of char;
  81.  
  82.   Async_Open_Flag    : Boolean;   { true if Open but no Close }
  83.   Async_Port         : Integer;   { current Open port number (1 or 2) }
  84.   Async_Base         : Integer;   { base for current open port }
  85.   Async_Irq          : Integer;   { irq for current open port }
  86.  
  87.   Async_Buffer_Overflow : Boolean;  { True if buffer overflow has happened }
  88.   Async_Buffer_Used     : Integer;
  89.   Async_MaxBufferUsed   : Integer;
  90.  
  91.     { Async_Buffer is empty if Head = Tail }
  92.   Async_Buffer_Head  : Integer;   { Locn in Async_Buffer to put next char }
  93.   Async_Buffer_Tail  : Integer;   { Locn in Async_Buffer to get next char }
  94.   Async_Buffer_NewTail : Integer;
  95. (*@\\\*)
  96. (*@/// user callable routines *)
  97. procedure Async_Init;
  98. { initialize variables }
  99.  
  100. procedure Async_Close;
  101. { reset the interrupt system when UART interrupts no longer needed }
  102.  
  103. function Async_Open(ComPort       : Integer;
  104.                     BaudRate      : Integer;
  105.                     Parity        : Char;
  106.                     WordSize      : Integer;
  107.                     StopBits      : Integer) : Boolean;
  108. { open a communications port }
  109.  
  110. function Async_Buffer_Check(var C : Char) : Boolean;
  111. { see if a character has been received; return it if yes }
  112.  
  113. procedure Async_Send(C : Char);
  114. { transmit a character }
  115.  
  116. procedure Async_Send_String(S : LStr);
  117. { transmit a string }
  118. (*@\\\*)
  119. (*@\\\0000000601*)
  120. (*@/// implementation *)
  121. implementation
  122.  
  123. (*@/// const registers... *)
  124. const
  125.   UART_THR = $00;    { offset from base of UART Registers for IBM PC }
  126.   UART_RBR = $00;
  127.   UART_IER = $01;
  128.   UART_IIR = $02;
  129.   UART_LCR = $03;
  130.   UART_MCR = $04;
  131.   UART_LSR = $05;
  132.   UART_MSR = $06;
  133.  
  134.   I8088_IMR = $21;   { port address of the Interrupt Mask Register }
  135. (*@\\\*)
  136. (*@/// var *)
  137. var
  138.   Async_BIOS_Port_Table : Array[1..2] of Integer absolute $40:0;
  139.                { This table is initialized by BIOS equipment determination
  140.                  code at boot time to contain the base addresses for the
  141.                  installed async adapters.  A value of 0 means "not in-
  142.                  stalled." }
  143. (*@\\\*)
  144. (*@/// const baud... *)
  145. const
  146.   Async_Num_Bauds = 8;
  147.   Async_Baud_Table : array [1..Async_Num_Bauds] of record
  148.                                                      Baud, Bits : integer
  149.                                                    end
  150.                    = ((Baud:110;  Bits:$00),
  151.                       (Baud:150;  Bits:$20),
  152.                       (Baud:300;  Bits:$40),
  153.                       (Baud:600;  Bits:$60),
  154.                       (Baud:1200; Bits:$80),
  155.                       (Baud:2400; Bits:$A0),
  156.                       (Baud:4800; Bits:$C0),
  157.                       (Baud:9600; Bits:$E0));
  158. (*@\\\*)
  159.  
  160. procedure DisableInterrupts; inline($FA {cli} );     {macros}
  161. procedure EnableInterrupts;  inline($FB {sti} );
  162.  
  163. (*@/// procedure BIOS_RS232_Init(ComPort, ComParm : Integer); *)
  164. procedure BIOS_RS232_Init(ComPort, ComParm : Integer);
  165. { Issue Interrupt $14 to initialize the UART }
  166. { See the IBM PC Technical Reference Manual for the format of ComParm }
  167. var
  168.   Regs : registers;
  169. begin
  170.   with Regs do
  171.     begin
  172.       ax := ComParm and $00FF;  { AH=0; AL=ComParm }
  173.       dx := ComPort;
  174.       Intr($14, Regs)
  175.     end
  176. end;
  177. (*@\\\*)
  178.  
  179. { ISR - Interrupt Service Routine }
  180. (*@/// procedure Async_Isr;  interrupt; *)
  181. procedure Async_Isr;  interrupt;
  182. { Interrupt Service Routine }
  183. { Invoked when the UART has received a byte of data from the
  184.   communication line }
  185.  
  186. { re-written 9/10/84 to be entirely in machine language; original source
  187.   left as comments }
  188.  
  189. begin
  190.   Inline(
  191.     $FB/                           { STI }
  192.       { get the incomming character }
  193.       { Async_Buffer[Async_Buffer_Head] := Chr(Port[UART_RBR + Async_Base]); }
  194.     $8B/$16/Async_Base/            { MOV DX,Async_Base }
  195.     $EC/                           { IN AL,DX }
  196.     $8B/$1E/Async_Buffer_Head/     { MOV BX,Async_Buffer_Head }
  197.     $88/$87/Async_Buffer/          { MOV Async_Buffer[BX],AL }
  198.       { Async_Buffer_NewHead := Async_Buffer_Head + 1; }
  199.     $43/                           { INC BX }
  200.       { if Async_Buffer_NewHead > Async_Buffer_Max then
  201.           Async_Buffer_NewHead := 0; }
  202.     $81/$FB/Async_Buffer_Max/      { CMP BX,Async_Buffer_Max }
  203.     $7E/$02/                       { JLE L001 }
  204.     $33/$DB/                       { XOR BX,BX }
  205.       { if Async_Buffer_NewHead = Async_Buffer_Tail then
  206.           Async_Buffer_Overflow := TRUE
  207.         else }
  208. {L001:}
  209.     $3B/$1E/Async_Buffer_Tail/     { CMP BX,Async_Buffer_Tail }
  210.     $75/$08/                       { JNE L002 }
  211.     $C6/$06/Async_Buffer_Overflow/$01/ { MOV Async_Buffer_Overflow,1 }
  212.     $90/                           { NOP generated by assembler for some reason }
  213.     $EB/$16/                       { JMP SHORT L003 }
  214.       { begin
  215.           Async_Buffer_Head := Async_Buffer_NewHead;
  216.           Async_Buffer_Used := Async_Buffer_Used + 1;
  217.           if Async_Buffer_Used > Async_MaxBufferUsed then
  218.             Async_MaxBufferUsed := Async_Buffer_Used
  219.         end; }
  220. {L002:}
  221.     $89/$1E/Async_Buffer_Head/     { MOV Async_Buffer_Head,BX }
  222.     $FF/$06/Async_Buffer_Used/     { INC Async_Buffer_Used }
  223.     $8B/$1E/Async_Buffer_Used/     { MOV BX,Async_Buffer_Used }
  224.     $3B/$1E/Async_MaxBufferUsed/   { CMP BX,Async_MaxBufferUsed }
  225.     $7E/$04/                       { JLE L003 }
  226.     $89/$1E/Async_MaxBufferUsed/   { MOV Async_MaxBufferUsed,BX }
  227. {L003:}
  228.       { disable interrupts }
  229.     $FA/                           { CLI }
  230.       { Port[$20] := $20; }  { use non-specific EOI }
  231.     $B0/$20/                       { MOV AL,20h }
  232.     $E6/$20                        { OUT 20h,AL }
  233.        )
  234. end;
  235. (*@\\\*)
  236. (*@/// procedure Async_Init; *)
  237. procedure Async_Init;
  238. { initialize variables }
  239. begin
  240.   Async_Open_Flag := FALSE;
  241.   Async_Buffer_Overflow := FALSE;
  242.   Async_Buffer_Used := 0;
  243.   Async_MaxBufferUsed := 0;
  244. end;
  245. (*@\\\*)
  246. (*@/// procedure Async_Close; *)
  247. procedure Async_Close;
  248. { reset the interrupt system when UART interrupts no longer needed }
  249. var
  250.   i, m : Integer;
  251. begin
  252.   if Async_Open_Flag then
  253.     begin
  254.       { disable the IRQ on the 8259 }
  255.       DisableInterrupts;
  256.       i := Port[I8088_IMR];        { get the interrupt mask register }
  257.       m := 1 shl Async_Irq;        { set mask to turn off interrupt }
  258.       Port[I8088_IMR] := i or m;
  259.  
  260.       { disable the 8250 data ready interrupt }
  261.       Port[UART_IER + Async_Base] := 0;
  262.  
  263.       { disable OUT2 on the 8250 }
  264.       Port[UART_MCR + Async_Base] := 0;
  265.       EnableInterrupts;
  266.  
  267.       SetIntVec(Async_Irq + 8,Async_OriginalVector);
  268.  
  269.       { re-initialize our data areas so we know the port is closed }
  270.       Async_Open_Flag := FALSE
  271.     end
  272. end;
  273. (*@\\\*)
  274. (*@/// function  Async_Open(...) : Boolean; *)
  275. function Async_Open(ComPort       : Integer;
  276.                     BaudRate      : Integer;
  277.                     Parity        : Char;
  278.                     WordSize      : Integer;
  279.                     StopBits      : Integer) : Boolean;
  280. { open a communications port }
  281. (*@/// var *)
  282. var
  283.   ComParm : Integer;
  284.   i, m : Integer;
  285. (*@\\\*)
  286. begin
  287. (*@///   start-up *)
  288. if Async_Open_Flag then Async_Close;
  289.  
  290. if (ComPort = 2) and (Async_BIOS_Port_Table[2] <> 0) then
  291.   Async_Port := 2
  292. else
  293.   Async_Port := 1;  { default to COM1 }
  294. Async_Base := Async_BIOS_Port_Table[Async_Port];
  295. Async_Irq := Hi(Async_Base) + 1;
  296. (*@\\\*)
  297.   if (Port[UART_IIR + Async_Base] and $00F8) <> 0 then
  298.     Async_Open := FALSE
  299.   else begin
  300. (*@///     prepare buffer *)
  301. Async_Buffer_Head := 0;
  302. Async_Buffer_Tail := 0;
  303. Async_Buffer_Overflow := FALSE;
  304. (*@\\\*)
  305. (*@///     init ComParm *)
  306. { Build the ComParm for RS232_Init }
  307. { See Technical Reference Manual for description }
  308.  
  309. ComParm := $0000;
  310. (*@\\\*)
  311. (*@///     Set up the bits for the baud rate *)
  312. i := 0;
  313. repeat
  314.   i := i + 1
  315. until (Async_Baud_Table[i].Baud = BaudRate) or (i = Async_Num_Bauds);
  316. ComParm := ComParm or Async_Baud_Table[i].Bits;
  317.  
  318. if Parity in ['E', 'e'] then ComParm := ComParm or $0018
  319. else if Parity in ['O', 'o'] then ComParm := ComParm or $0008
  320. else ComParm := ComParm or $0000;  { default to No parity }
  321.  
  322. if WordSize = 7 then ComParm := ComParm or $0002
  323. else ComParm := ComParm or $0003;  { default to 8 data bits }
  324.  
  325. if StopBits = 2 then ComParm := ComParm or $0004
  326. else ComParm := ComParm or $0000;  { default to 1 stop bit }
  327. (*@\\\*)
  328. (*@///     use the BIOS COM port initialization routine to save typing the code *)
  329. BIOS_RS232_Init(Async_Port - 1, ComParm);
  330.  
  331. GetIntVec(Async_Irq + 8, Async_OriginalVector);
  332. SetIntVec(Async_Irq + 8, @Async_Isr);
  333. (*@\\\*)
  334. (*@///     read the RBR and reset any possible pending error conditions *)
  335. { first turn off the Divisor Access Latch Bit to allow access to RBR, etc. }
  336.  
  337. DisableInterrupts;
  338.  
  339. Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] and $7F;
  340. (*@\\\*)
  341. (*@///     read the Line Status Register to reset any errors it indicates *)
  342. i := Port[UART_LSR + Async_Base];
  343. (*@\\\*)
  344. (*@///     read the Receiver Buffer Register in case it contains a character *)
  345. i := Port[UART_RBR + Async_Base];
  346. (*@\\\*)
  347. (*@///     enable the irq on the 8259 controller *)
  348. i := Port[I8088_IMR];  { get the interrupt mask register }
  349. m := (1 shl Async_Irq) xor $00FF;
  350. Port[I8088_IMR] := i and m;
  351. (*@\\\*)
  352. (*@///     enable the data ready interrupt on the 8250 *)
  353. Port[UART_IER + Async_Base] := $01; { enable data ready interrupt }
  354. (*@\\\*)
  355. (*@///     enable OUT2 on 8250 *)
  356. i := Port[UART_MCR + Async_Base];
  357. Port[UART_MCR + Async_Base] := i or $08;
  358.  
  359. EnableInterrupts;
  360. Async_Open_Flag := TRUE;  { bug fix by Scott Herr }
  361. Async_Open := TRUE
  362. (*@\\\*)
  363.     end end;
  364. (*@\\\*)
  365. (*@/// function  Async_Buffer_Check(var C : Char) : Boolean; *)
  366. function Async_Buffer_Check(var C : Char) : Boolean;
  367. { see if a character has been received; return it if yes }
  368. begin
  369.   if Async_Buffer_Head = Async_Buffer_Tail then
  370.     Async_Buffer_Check := FALSE
  371.   else
  372.     begin
  373.       C := Async_Buffer[Async_Buffer_Tail];
  374.       Async_Buffer_Tail := Async_Buffer_Tail + 1;
  375.       if Async_Buffer_Tail > Async_Buffer_Max then
  376.         Async_Buffer_Tail := 0;
  377.       Async_Buffer_Used := Async_Buffer_Used - 1;
  378.       Async_Buffer_Check := TRUE
  379.     end
  380. end;
  381. (*@\\\*)
  382. (*@/// procedure Async_Send(C : Char); *)
  383. procedure Async_Send(C : Char);
  384. { transmit a character }
  385. var
  386.   i, m, counter : Integer;
  387. begin
  388.   Port[UART_MCR + Async_Base] := $0B; { turn on OUT2, DTR, and RTS }
  389. (*@///   wait for CTS *)
  390. counter := MaxInt;
  391. while (counter <> 0) and ((Port[UART_MSR + Async_Base] and $10) = 0) do
  392.   counter := counter - 1;
  393. (*@\\\*)
  394. (*@///   wait for Transmit Hold Register Empty (THRE) *)
  395. if counter <> 0 then counter := MaxInt;
  396. while (counter <> 0) and ((Port[UART_LSR + Async_Base] and $20) = 0) do
  397.   counter := counter - 1;
  398. (*@\\\*)
  399.   if counter <> 0 then
  400.     begin
  401.       { send the character }
  402.       DisableInterrupts;
  403.       Port[UART_THR + Async_Base] := Ord(C);
  404.       EnableInterrupts
  405.     end
  406.   else
  407.     writeln('<<<TIMEOUT>>>');
  408. end;
  409. (*@\\\*)
  410. (*@/// procedure Async_Send_String(S : LStr); *)
  411. procedure Async_Send_String(S : LStr);
  412. { transmit a string }
  413. var
  414.   i : Integer;
  415. begin
  416.   for i := 1 to length(S) do
  417.     Async_Send(S[i])
  418. end;
  419. (*@\\\*)
  420. (*@\\\0002000301000301*)
  421. end.
  422. (*@\\\0001000011000601*)
  423.